home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
scope
/
001-025
/
scopedisk9
/
titlebar
/
pattern
next >
Wrap
Text File
|
1995-03-18
|
3KB
|
157 lines
'=======================================
' TitleBarPatterns
' by Robert L. Barton
' version 1.1
' 88/01/19
'=======================================
'Constants
DEFINT ami, bar, check, diam, heart, pat, quit, sol
pat = 5
bar = 1
diam = 2
heart = 3
sol = 4
check = 5
ami = 6
quit = 7
iName$ = "intuition.library" + CHR$(0)
'Variables
DEFINT item, menuID
DEFLNG iBase, iNamePtr
'Library Functions
DECLARE FUNCTION OpenLibrary& LIBRARY
'=======================================
LIBRARY "exec.library"
iNamePtr = SADD(iName$)
iBase = OpenLibrary&(iNamePtr, 0)
IF iBase = 0 THEN
PRINT "Can't open intuition library"
END
END IF
MENU pat, 0, 1, "Pattern"
MENU pat, bar, 1, "Bars "
MENU pat, diam, 1, "Diamonds "
MENU pat, heart, 1, "Hearts "
MENU pat, sol, 1, "Solid "
MENU pat, check, 1, "Checks "
MENU pat, ami, 1, "Amiga A's"
MENU pat, quit, 1, "Quit "
ON MENU GOSUB CheckMenu
MENU ON
WHILE 1
SLEEP
WEND
CheckMenu:
menuID = MENU(0)
IF menuID = pat THEN 'Pattern menu selected
item = MENU(1)
IF item = bar THEN CALL Default
IF item = diam THEN CALL Diamonds
IF item = heart THEN CALL Hearts
IF item = sol THEN CALL Solid
IF item = check THEN CALL CheckMark
IF item = ami THEN CALL AmigaA
IF item = quit THEN
MENU RESET
END
END IF
END IF
RETURN
END
'=======================================
SUB Default STATIC
SHARED iBase
POKEW iBase + 790, &H0
POKEW iBase + 792, &H0
POKEW iBase + 794, &HFFFF
POKEW iBase + 796, &HFFFF
POKEW iBase + 798, &H0
POKEW iBase + 800, &H0
POKEW iBase + 802, &HFFFF
POKEW iBase + 804, &HFFFF
END SUB
'=======================================
SUB Diamonds STATIC
SHARED iBase
POKEW iBase + 790, &H0
POKEW iBase + 792, &H180
POKEW iBase + 794, &H3C0
POKEW iBase + 796, &H7E0
POKEW iBase + 798, &HFF0
POKEW iBase + 800, &H7E0
POKEW iBase + 802, &H3C0
POKEW iBase + 804, &H180
END SUB
'=======================================
SUB Hearts STATIC
SHARED iBase
POKEW iBase + 790, &H0
POKEW iBase + 792, &HC30
POKEW iBase + 794, &H1E78
POKEW iBase + 796, &H1FF8
POKEW iBase + 798, &HFF0
POKEW iBase + 800, &H7E0
POKEW iBase + 802, &H3C0
POKEW iBase + 804, &H180
END SUB
'=======================================
SUB Solid STATIC
SHARED iBase
POKEW iBase + 790, &HFFFF
POKEW iBase + 792, &HFFFF
POKEW iBase + 794, &HFFFF
POKEW iBase + 796, &HFFFF
POKEW iBase + 798, &HFFFF
POKEW iBase + 800, &HFFFF
POKEW iBase + 802, &HFFFF
POKEW iBase + 804, &HFFFF
END SUB
'=======================================
SUB CheckMark STATIC
SHARED iBase
POKEW iBase + 790, &HF1FF
POKEW iBase + 792, &HFFF1
POKEW iBase + 794, &HFFE7
POKEW iBase + 796, &HFFCF
POKEW iBase + 798, &HFF9F
POKEW iBase + 800, &HF3F
POKEW iBase + 802, &HC67F
POKEW iBase + 804, &HE0FF
END SUB
'=======================================
SUB AmigaA STATIC
SHARED iBase
POKEW iBase + 790, &H0
POKEW iBase + 792, &HF0
POKEW iBase + 794, &H1F0
POKEW iBase + 796, &H3F0
POKEW iBase + 798, &H770
POKEW iBase + 800, &HFF0
POKEW iBase + 802, &H1C70
POKEW iBase + 804, &H7CF8
END SUB
'=======================================